       IDENTIFICATION DIVISION.
       PROGRAM-ID.  resmain.
      *  resmain allows a user to enter a word, and calls a subroutine
      *  to check if that word is a RESERVED WORD.
      *
      *  The following compiler flags should be set:
      *  -o .\object  Place the compiler output into the object directory
      *  -t .\lst     Place the listing output into the lst directory
      *  -I .\copy    Search the copy directory for copy files
      *  -ext fd -ext sl Include files with extension .fd and .sl in copyfile search
      * 
      *  The following environment variables should be set: 
      *  COBOLITDIR=C:\COBOL\CobolIT
      *  Automatically set when the Developer Studio is started from the Desktop Icon. 
      *  COBOLITDIR is the root directory where COBOL-IT is installed.  Used for location 
      *  of compiler, runtime, compiler configuration files, debugger.
      * 
      *  COB_LIBRARY_PATH=.\object
      *  Since we're compiling the objects into a separate directory, we must
      *  name it in the COB_LIBRARY_PATH, in order for the runtime to find it.
      *  
      *  To compile: cobc -g -o .\object -t .\lst -I .\copy -ext sl -ext fd resmain.cbl
      *  To run:     cobcrun resmain
      *
       ENVIRONMENT DIVISION.
       INPUT-OUTPUT SECTION.
       FILE-CONTROL.
           COPY "reslist.sl".
      *
           COPY "reswords.sl".
      *
       DATA DIVISION.
       FILE SECTION.
       COPY "reslist.fd".
      *
       COPY "reswords.fd".
      *
       WORKING-STORAGE SECTION.
       77 reswords-stat           PIC XX.
         88 end-of-reswords                 VALUE "10".
       77 reslist-stat            PIC XX.
         88 end-of-reslist                  VALUE "10".
         88 reslist-not-found               VALUE "35".
       77 dummy                          PIC X.
       77 new-dir                        PIC X(4).
       77 call-status                    PIC s9(9).
       01  rescheck-scr-flds.
         05  ws-checkword                PIC X(32) VALUE SPACES.
         05  ws-checkword-status         PIC 9.           
           88 checkword-is-reserved                VALUE 1.
         05  ws-checkword-error-msg      PIC X(25).
       01 msg-scr-flds.
         05  ws-rescheck-done            PIC X     VALUE SPACES.
           88 all-done                             VALUES "x", "X".
         05  closing-message             PIC X(25) VALUE SPACES.
      *
       SCREEN SECTION.
      *
       01  resmain-scr.
           05  VALUE "Reserved Word Check"       BLANK SCREEN
                                                 LINE 02 COL 20.
           05  VALUE "This program ACCEPTs a word as input" 
                                                 LINE 04 COL 20.
           05  VALUE "and calls a sub-program to determine if " 
                                                 LINE 05 COL 20.
           05  VALUE "the word is a reserved word." 
                                                 LINE 06 COL 20.
           05  VALUE "Type a word: "             LINE 10 COL 5.
           05  scr-checkword                     ERASE EOL
                                                 LINE 10 COL 20
                                                 PIC X(32)              
                                                 USING ws-checkword.
       01  rescheck-error.
           05 rescheck-error-msg                    LINE 24 COL 05
                               PIC X(25) from ws-checkword-error-msg.      
           05 resmain-dummy                      AUTO                        
                                                 LINE 24 COL 45
                                                 PIC X 
                                                 USING ws-rescheck-done.
      *
       01  resmain-msg.     
           05 scr-closing-msg                    ERASE EOS
                                                 LINE 23 COL 05
                                                 PIC X(25) 
                                                 FROM closing-message.      
           05 VALUE "Type 'X' to Exit, [Return] TO Continue: " 
                                                 LINE 24 COL 05.
           05 resmain-dummy                      AUTO                        
                                                 LINE 24 COL 45
                                                 PIC X 
                                                 USING ws-rescheck-done.
      *
       PROCEDURE DIVISION.
       MAINLINE.
       
           PERFORM CREATE-FILES.
          
           PERFORM UNTIL all-done
             PERFORM GET-RESERVED-WORD
             IF NOT all-done
               PERFORM CHECK-RESERVED-WORD
             END-IF
             PERFORM SHOW-RESULTS
           END-PERFORM.
           PERFORM EXIT-PROGRAM.
      *
       CREATE-FILES.
           PERFORM CREATE-RESLIST.
           PERFORM CREATE-RESWORDS.
      *
       CREATE-RESLIST.
           MOVE "data" TO new-dir.
           CALL "CBL_CHANGE_DIR" USING new-dir GIVING call-status.
           CALL "SYSTEM" USING "cobc -list-reserved > reslist.txt".
           CALL "CBL_CHANGE_DIR" USING ".." GIVING call-status.
      *
       CREATE-RESWORDS.
           OPEN OUTPUT reswords.
           OPEN INPUT reslist.
      * The first two records in reslist.txt are commentary.
           READ reslist NEXT RECORD.
           READ reslist NEXT RECORD.
      *
           PERFORM UNTIL end-of-reslist
               PERFORM WRITE-RESWORDS
           END-PERFORM.
           CLOSE reslist, reswords.
      *
       WRITE-RESWORDS. 
           INITIALIZE RESLIST-RECORD.
      * READ each reserved word, and WRITE it to an indexed file
           READ reslist NEXT RECORD
               AT END MOVE "10" TO reslist-stat
               NOT AT END
      * The reserved word list also contains a list of unreserved words
      * When unreserved words are reached, set end of file condition  
                 IF RESLIST-RECORD = "Reserved Words not yet supported"
                   MOVE "10" TO reslist-stat
                 ELSE
      * cobc -list-reserved output contains tab ( X"09" ) delimiters
      * Convert tabs to spaces before MOVEing data to indexed file.
                   INSPECT reslist-record CONVERTING ALL X"09" TO SPACE
                   INITIALIZE reswords-record
                   MOVE reslist-record TO reserved-word
                   WRITE reswords-record
                 END-IF 
           END-READ.
      *
       GET-RESERVED-WORD.
           INITIALIZE msg-scr-flds, rescheck-scr-flds.
           DISPLAY resmain-scr.
           ACCEPT resmain-scr.
      *
       CHECK-RESERVED-WORD
           CALL "rescheck" 
              USING ws-checkword, 
                    ws-checkword-status,
                    ws-checkword-error-msg
           ON EXCEPTION 
              DISPLAY "CALLed program rescheck not found." 
                                             line 24 col 5
              ACCEPT dummy line 24 col 40
              PERFORM EXIT-PROGRAM     
           END-CALL.
      *
       SHOW-RESULTS.
           IF ws-checkword-error-msg = SPACES
             PERFORM SHOW-VALIDATION-RESULT
           ELSE
             DISPLAY rescheck-error
             ACCEPT rescheck-error
             PERFORM EXIT-PROGRAM
           END-IF.
      *
       EXIT-PROGRAM.
           STOP RUN. 
       SHOW-VALIDATION-RESULT.
           INITIALIZE closing-message.
           IF checkword-is-reserved
             STRING ws-checkword, DELIMITED BY SPACES, 
                   " IS RESERVED.", DELIMITED BY SIZE, 
                                  INTO closing-message
           ELSE  
             STRING ws-checkword, DELIMITED BY SPACES, 
                   " IS NOT RESERVED.", DELIMITED BY SIZE, 
                                  INTO closing-message
                      
           END-IF.
           DISPLAY resmain-scr.
           DISPLAY resmain-msg.
           ACCEPT resmain-msg.
              